Syntax10.Scn.Fnt
InfoElems
Alloc
Syntax10.Scn.Fnt
StampElems
Alloc
25 Jan 96
"Title": 
"Author": 
"Abstract": 
"Keywords": 
"Version": 
"From":  27.06.95 13:41:44
"Until": S
"Changes": 
	27.6.95	mah	Finalize in System.Quit
	22.9.95	mah	Error in HomeDir corrected
Syntax10i.Scn.Fnt
Syntax12.Scn.Fnt
Syntax10b.Scn.Fnt
MODULE System; (*JG 25.4.90, NW 22.4.90, JT 7.5.90 / 21.01.93, RC 2.6.91, MB 21.6.91 / 13.10.93 *)
	IMPORT
		SYSTEM, Sys, Kernel, Modules, Files, Input, Display, Macintosh, Directories,
		Viewers, MenuViewers, Oberon, Fonts, Texts, TextFrames, Strings;
	CONST
		StandardMenu = "System.Close System.Copy System.Grow Edit.Search Edit.Store ";
		LogMenu = "System.Close System.Grow Edit.Locate Edit.Store ";
		VersionString = "PowerMac Oberon V4 (TM) 1.4";
		dateOpt = 1; sizeOpt = 2; allPaths = 3; (* Directory Options *)
		(* structure forms *)
		Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6;
		Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
		Pointer = 13; ProcTyp = 14; Comp = 15;
		(* special registers *)
		SP = 1; SB = 2; FP = 31;
		(* register modes *)
		Reg = 16; FReg = 18; Cond = 19;
		T: Texts.Text; W: Texts.Writer;
		trap, t, d: LONGINT;
		options: SET;	(*options in System.Directory*)
		pattern: ARRAY 256 OF CHAR;	(*search pattern in System.Directory*)
		startupDone, fullPath: BOOLEAN;
		OldTrap: Sys.ExceptionHandler;
	PROCEDURE ReadInt (VAR i: LONGINT; VAR pos: LONGINT);
		VAR n: LONGINT; s: SHORTINT; x: CHAR;
	BEGIN
		s := 0; n := 0; SYSTEM.GET(pos, x); INC(pos);
		WHILE ORD(x) >= 128 DO INC(n, ASH(ORD(x) - 128, s)); INC(s, 7); SYSTEM.GET(pos, x); INC(pos) END;
		i := n + ASH(ORD(x) MOD 64 - ORD(x) DIV 64 * 64, s)
	END ReadInt;
	PROCEDURE WriteVariable (adr, form: LONGINT; regalloc: BOOLEAN);
		VAR ch: CHAR; si: SHORTINT; i: INTEGER; li: LONGINT; r: REAL; lr: LONGREAL;
	BEGIN
		IF regalloc & (form IN {Byte, Bool, Char}) THEN INC(adr, 3) END;
		SYSTEM.GET(adr, li);
		CASE form OF
			Byte: SYSTEM.GET(adr, ch); Texts.WriteHex(W, ORD(ch)); Texts.Write(W, "H")
		|  Char: SYSTEM.GET(adr, ch);
				IF (" " < ch) & (ch <= "z") THEN Texts.Write(W, 22X); Texts.Write(W, ch); Texts.Write(W, 22X)
				ELSE Texts.WriteHex(W, ORD(ch)); Texts.Write(W, "X")
				END
		|  Bool: SYSTEM.GET(adr, ch);
				IF ch # 0X THEN Texts.WriteString(W, "TRUE") ELSE Texts.WriteString(W, "FALSE") END
		|  SInt:
				IF ~regalloc THEN SYSTEM.GET(adr, si); Texts.WriteInt(W, si, 0) ELSE Texts.WriteInt(W, li, 0) END
		|  Int:
				IF ~regalloc THEN SYSTEM.GET(adr, i); Texts.WriteInt(W, i, 0) ELSE Texts.WriteInt(W, li, 0) END
		|  LInt: Texts.WriteInt(W, li, 0)
		|  Real: IF regalloc THEN SYSTEM.GET(adr, lr); r := SHORT(lr) ELSE SYSTEM.GET(adr, r) END; 
				Texts.WriteReal(W, r, 16)
		|  LReal: SYSTEM.GET(adr, lr); Texts.WriteLongReal(W, lr, 24)
		|  Set, Pointer: Texts.WriteHex(W, li); Texts.Write(W, "H")
		|  Comp:
				i := 1; SYSTEM.GET(adr, ch); Texts.Write(W, 22X);
				WHILE (i < 32) & (ch # 0X) DO Texts.Write(W, ch); SYSTEM.GET(adr+i, ch); INC(i) END;
				Texts.Write(W, 22X)
		ELSE Texts.WriteString(W, "invalid form")
		END
	END WriteVariable;
	PROCEDURE OverReadTypes (VAR pos: LONGINT; VAR form: SHORTINT);   (* MK *)
		VAR n: LONGINT; si: SHORTINT; ch: CHAR;
	BEGIN
		SYSTEM.GET (pos, form); SYSTEM.GET (pos, ch); INC (pos);
		IF ch = CHR (ProcTyp) THEN ReadInt (n, pos)	
		ELSIF ch = 0FX THEN ReadInt (n, pos); ReadInt (n, pos); OverReadTypes (pos, si)
		ELSIF ch = 10X THEN INC (pos); ReadInt (n, pos)
		ELSIF ch = 11X THEN ReadInt (n, pos); OverReadTypes (pos, si)
		ELSIF ch = CHR (Pointer) THEN OverReadTypes (pos, si)
		END
	END OverReadTypes;
	PROCEDURE Locals (VAR info: Sys.ExceptionInfoDesc; VAR ref: LONGINT; refend, base: LONGINT);
		VAR
			pos, adr, mode: LONGINT;
			ch, VarFlag: CHAR;
			form: SHORTINT;
			name: ARRAY 256 OF CHAR; i: INTEGER;
	BEGIN
		pos := ref; SYSTEM.GET(pos, VarFlag); INC(pos); Texts.WriteLn(W);
		WHILE (pos < refend) & (VarFlag # 0F8X) & (VarFlag # 0F7X) DO
			i := 0;
			REPEAT
				SYSTEM.GET(pos, ch); INC(pos);
				name[i] := ch; INC (i)
			UNTIL (ch = 0X) OR (pos >= refend);
			ReadInt(adr, pos);
			OverReadTypes (pos, form);
			IF (form <= 31) & (form >= 0) & (form IN {Byte, Char, Bool, SInt, Int, LInt, Real, LReal, Set, Pointer, Comp}) THEN
				Texts.Write (W, 9X); Texts.WriteString (W, name); Texts.WriteString(W, " = ");
				IF adr < 0 THEN
					adr := -1-adr; mode := adr DIV 32; adr := adr MOD 32;
					IF VarFlag = 3X THEN
						IF mode # Reg THEN Texts.WriteString(W, "VarPar in register other than reg.R "); Texts.WriteLn(W) END;
						WriteVariable(info.reg.R[2*adr+1], form, FALSE)
					ELSE
						IF mode = Reg THEN WriteVariable(SYSTEM.ADR(info.reg.R[2*adr+1]), form, TRUE)
						ELSIF mode = FReg THEN WriteVariable(SYSTEM.ADR(info.fp.R[2*adr]), form, TRUE)
						ELSIF adr IN SYSTEM.VAL(SET, info.spec.CR) THEN Texts.WriteString(W, "TRUE")
						ELSE Texts.WriteString(W, "FALSE")
						END
					END
				ELSE
					WriteVariable(adr+base, form, FALSE)
				END;  
				Texts.WriteLn(W)
			END;
			SYSTEM.GET (pos, VarFlag); INC (pos)
		END;
		ref := pos-1
	END Locals;
	PROCEDURE FindProc (pc: LONGINT; VAR mod: Modules.Module; VAR refpos, refend: LONGINT);
		VAR m: Modules.Module; ref, p: LONGINT; ch: CHAR;
	BEGIN
		m := Modules.modules; mod := NIL; refpos := -1;
		WHILE (m # NIL) & ((pc < m^.PC) OR (m^.PC+m^.codesize*4 < pc)) DO m := m^.link END;
		IF m # NIL THEN mod := m;
			pc := (pc - m^.PC) DIV 4;
			ref := m^.refs; refend := ref; p := 0;
			IF mod^.refs # 0 THEN INC(refend, m^.refsize) END;
			LOOP
				IF ref >= refend THEN EXIT END;
				SYSTEM.GET(ref, ch); INC(ref);
				IF ch = 0F8X THEN
					ReadInt(p, ref);
					IF p >= pc THEN refpos := ref; EXIT END
				END
			END
		END
	END FindProc;
	PROCEDURE FindTrapClass (mod: Modules.Module; pc: LONGINT; VAR p: LONGINT);
		VAR pos, len: LONGINT; trap : Modules.TrapDescPtr; 
	BEGIN
		pc := (pc - mod^.PC) DIV 4; p := 256;
		pos := 0; len := 0; IF mod^.traps # 0 THEN len := mod^.noftraps END;
		trap:= SYSTEM.VAL (Modules.TrapDescPtr, mod.traps);
		WHILE (pos < len) & (pc # trap.offset) DO
			INC(pos);
			trap:=SYSTEM.VAL (Modules.TrapDescPtr, SYSTEM.VAL (LONGINT, trap)+4);
		END;
		IF pos < len THEN p := trap.trapno END
	END FindTrapClass;
	PROCEDURE Trap (info: Sys.ExceptionInfo) : LONGINT;
		VAR
			V: Viewers.Viewer;
			mod: Modules.Module;
			ch: CHAR;
			pc, sp, ref, refend, p, fsize, psize, ralloc, falloc, calloc, nofFrames, stackBottom: LONGINT;
			X, Y: INTEGER;
			leaf, body, first: BOOLEAN;
			cur : Sys.ExceptionInfoDesc;
	BEGIN
		cur:=info^;
		IF cur.spec.PC = Macintosh.kbdIntPC THEN
			SYSTEM.PUT (Macintosh.kbdIntPC, Macintosh.kbdIntInstr);	(* restore patched code *)
			Macintosh.kbdIntPC := 0
		END;
		IF trap < 2 THEN
			INC(trap);
			IF trap > 1 THEN
				(* recursive trap ???? No console, so do nothing *)
				Texts.WriteString(W, "Recursive trap "); Texts.WriteLn(W); Texts.Append (T, W.buf); DEC (trap);
			END;
			T := TextFrames.Text("");
			Oberon.AllocateSystemViewer(0, X, Y);
			V := MenuViewers.New(
				TextFrames.NewMenu("System.Trap", StandardMenu),
				TextFrames.NewText(T, 0),
				TextFrames.menuH,
				X, Y);
			IF V.state > 0 THEN
				IF trap > 1 THEN Texts.WriteString(W, "*** recursive trap"); Texts.WriteLn(W); DEC (trap) END;
				pc := cur.spec.PC; sp := cur.reg.R[2*1+1];
				Texts.WriteString(W, "Trap "); Texts.WriteInt(W, cur.kind, 0);
				IF pc = 0 THEN
					Texts.WriteString(W, " (NIL procedure called)");
					pc := cur.spec.LR
				ELSE
					CASE cur.kind OF
						0: Texts.WriteString(W, " (Unknown exception)")
					|   1: Texts.WriteString(W, " (Illegal instruction)")
					|   2: FindProc(pc, mod, ref, refend); IF mod # NIL THEN FindTrapClass(mod, pc, p) ELSE p := 256 END;
							IF p > 255 THEN Texts.WriteString(W, " (Breakpoint)")
							ELSE 
								Texts.Write(W, "."); Texts.WriteInt(W, p, 0);
								CASE p OF
									0: Texts.WriteString(W, " (ASSERT failed)")
								|   1: Texts.WriteString(W, " (Index out of range)")
								|   2: Texts.WriteString(W, " (Integer division by value <= 0)")
								|   3: Texts.WriteString(W, " (Invalid case in CASE statement)")
								|   4: Texts.WriteString(W, " (Type guard check)")
								|   5: Texts.WriteString(W, " (Function procedure without RETURN statement)")
								|   6: Texts.WriteString(W, " (Invalid array dimension in NEW)")
								|   7: Texts.WriteString(W, " (NIL check)")
								ELSE 
									Texts.WriteString(W, " (HALT("); Texts.WriteInt(W, p, 0); Texts.WriteString(W, ") called)")
								END
							END
					|   3: Texts.WriteString(W, " (Failed memory access)")
					|   4: Texts.WriteString(W, " (Unmapped memory)")
					|   5: Texts.WriteString(W, " (Excluded memory)")
					|   6: Texts.WriteString(W, " (Read only memory)")
					|   7: Texts.WriteString(W, " (Page fault)")
					|   8: Texts.WriteString(W, " (Privilege violation)")
					| 10: Texts.WriteString(W, " (Instruction breakpoint)")
					| 11: Texts.WriteString(W, " (Data breakpoint)")
					| 12: Texts.WriteString(W, " (Unused)")
					| 13: Texts.WriteString(W, " (Floating point)")
					| 14: Texts.WriteString(W, " (Stack overflow)")
					| 15: Texts.WriteString(W, " (Task terminated)")
					ELSE
					END
				END;
				Texts.WriteLn(W); Texts.Append(T, W.buf);
				nofFrames := 0; first := TRUE;
				stackBottom := Kernel.resumeSP;
				WHILE (sp <= stackBottom) & (nofFrames < 64) DO
					FindProc(pc, mod, ref, refend);
					IF mod # NIL THEN
						Texts.WriteString(W, mod^.name);
						IF ref > 0 THEN
							ReadInt(fsize, ref); ReadInt(psize, ref); ReadInt(ralloc, ref); ReadInt(falloc, ref); ReadInt(calloc, ref);
							SYSTEM.GET(ref, leaf); INC(ref);
							Texts.Write(W, ".");
							SYSTEM.GET(ref, ch); INC(ref); body := ch = "$";
							WHILE (ch # 0X) & (ref < refend) DO
								Texts.Write(W, ch); SYSTEM.GET(ref, ch); INC(ref)
							END;
							Texts.Write(W, " ");
							IF first THEN Texts.WriteHex(W, pc-mod^.PC); first := FALSE
							ELSE Texts.WriteHex(W, pc-mod^.PC-4)
							END;
							Texts.Write(W, "H");
							IF body THEN p := mod^.SB ELSE p := cur.reg.R[31*2+1] END;
							Locals(cur, ref, refend, p);
							SYSTEM.GET(sp, sp);
							IF leaf THEN pc := cur.spec.LR ELSE SYSTEM.GET(sp+8, pc) END;
							p := sp-(31-ralloc)*4;
							WHILE ralloc < 31 DO INC(ralloc); SYSTEM.GET(p, cur.reg.R[2*ralloc+1]); INC(p, 4) END;
							INC(p, (-p) MOD 8);
							WHILE falloc < 31 DO INC(falloc); SYSTEM.GET(p, cur.fp.R[2*falloc+1]); INC(p, 8) END;
							IF calloc < 19 THEN SYSTEM.GET(sp+4, cur.spec.CR) END
						ELSE
							SYSTEM.GET(sp, sp); SYSTEM.GET(sp+8, pc)
						END
					ELSE
						Texts.WriteString(W, "unknown procedure ");
						Texts.WriteHex(W, pc); Texts.Write(W, "H"); Texts.WriteLn(W);
						Texts.Append(T, W.buf); DEC(trap);
						Kernel.Resume (info);
						RETURN 0
					END;
					Texts.Append(T, W.buf); INC(nofFrames)
				END
			END
		END;
		DEC(trap);
		Kernel.Resume (info);
		RETURN 0;
	END Trap;
	PROCEDURE Max (i, j: LONGINT): LONGINT;
	BEGIN IF i >= j THEN RETURN i ELSE RETURN j END
	END Max;
	PROCEDURE Open*;
		VAR par: Oberon.ParList;
			T: Texts.Text;
			S: Texts.Scanner;
			V: Viewers.Viewer;
            X, Y: INTEGER;
            beg, end, time: LONGINT;
	BEGIN
		par := Oberon.Par;
		Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
		IF (S.class = Texts.Char) & (S.c = "^") OR (S.line # 0) THEN
			Oberon.GetSelection(T, beg, end, time);
			IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END
		END;
        IF (S.class = Texts.Name) OR (S.class = Texts.String) THEN
            Oberon.AllocateSystemViewer(par.vwr.X, X, Y);
		    V := MenuViewers.New(
              TextFrames.NewMenu(S.s, "^System.Menu.Text"),
              TextFrames.NewText(TextFrames.Text(S.s), 0),
              TextFrames.menuH,
              X, Y)
        END
	END Open;
	PROCEDURE OpenLog*;
      VAR logV: Viewers.Viewer; X, Y: INTEGER;
	BEGIN
        Oberon.AllocateSystemViewer(Oberon.Par.vwr.X, X, Y);
        logV := MenuViewers.New(
          TextFrames.NewMenu("System.Log", "^Log.Menu.Text"),
          TextFrames.NewText(Oberon.Log, Max(0, Oberon.Log.len - 200)),
          TextFrames.menuH,
          X, Y)
	END OpenLog;
	PROCEDURE ClearLog*;
	BEGIN Texts.Delete(Oberon.Log, 0, Oberon.Log.len)
	END ClearLog;
	PROCEDURE Close*;
		VAR par: Oberon.ParList; V: Viewers.Viewer;
	BEGIN
		par := Oberon.Par;
		IF par.frame = par.vwr.dsc THEN V := par.vwr
		ELSE V := Oberon.MarkedViewer()
		END;
		Viewers.Close(V)
	END Close;
	PROCEDURE CloseTrack*;
      VAR V: Viewers.Viewer;
	BEGIN V := Oberon.MarkedViewer(); Viewers.CloseTrack(V.X)
	END CloseTrack;
    PROCEDURE Recall*;
      VAR V: Viewers.Viewer; M: Viewers.ViewerMsg;
    BEGIN
      Viewers.Recall(V);
      IF (V # NIL) & (V.state = 0) THEN
        Viewers.Open(V, V.X, V.Y + V.H); M.id := Viewers.restore; V.handle(V, M)
      END
    END Recall;
	PROCEDURE Copy*;
		VAR V, V1: Viewers.Viewer; M: Oberon.CopyMsg; N: Viewers.ViewerMsg;
	BEGIN
        V := Oberon.Par.vwr; V.handle(V, M); V1 := M.F(Viewers.Viewer);
        Viewers.Open(V1, V.X, V.Y + V.H DIV 2);
        N.id := Viewers.restore; V1.handle(V1, N)
	END Copy;
	PROCEDURE Grow*;
		VAR V, V1: Viewers.Viewer; M: Oberon.CopyMsg; N: Viewers.ViewerMsg;
          DW, DH: INTEGER;
	BEGIN V := Oberon.Par.vwr;
        DW := Oberon.DisplayWidth(V.X); DH := Oberon.DisplayHeight(V.X);
		IF V.H < DH - Viewers.minH THEN Oberon.OpenTrack(V.X, V.W)
          ELSIF V.W < DW THEN Oberon.OpenTrack(Oberon.UserTrack(V.X), DW)
        END;
        IF (V.H < DH - Viewers.minH) OR (V.W < DW) THEN
          V.handle(V, M); V1 := M.F(Viewers.Viewer);
          Viewers.Open(V1, V.X, DH);
          N.id := Viewers.restore; V1.handle(V1, N)
       END
	END Grow;
	PROCEDURE GetArg (VAR S: Texts.Scanner);
		VAR T: Texts.Text; beg, end, time: LONGINT;
	BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
		IF (S.class = Texts.Char) & (S.c = "^") THEN
			Oberon.GetSelection(T, beg, end, time);
			IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END
		END
	END GetArg;
	PROCEDURE EndLine;
	BEGIN Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
	END EndLine;
	PROCEDURE SetFont*;
		VAR S: Texts.Scanner;
	BEGIN GetArg(S);
		IF S.class = Texts.Name THEN Oberon.SetFont(Fonts.This(S.s)) END
	END SetFont;
	PROCEDURE SetColor*;
		VAR S: Texts.Scanner;
	BEGIN GetArg(S);
		IF S.class = Texts.Int THEN Oberon.SetColor(SHORT(SHORT(S.i))) END
	END SetColor;
	PROCEDURE SetOffset*;
		VAR S: Texts.Scanner;
	BEGIN GetArg(S);
		IF S.class = Texts.Int THEN Oberon.SetOffset(SHORT(SHORT(S.i))) END
	END SetOffset;
	PROCEDURE Time*;
		VAR t, d: LONGINT;
	BEGIN
		Texts.WriteString(W, "System.Time");
		Oberon.GetClock(t, d); Texts.WriteDate(W, t, d); Texts.WriteLn(W);
		Texts.Append(Oberon.Log, W.buf)
	END Time;
	PROCEDURE AboutOberon*;
	BEGIN	Macintosh.AboutOberon
	END AboutOberon;
	PROCEDURE Watch*;
		VAR avail: LONGINT;
	BEGIN
		Texts.WriteString(W, "System.Watch"); Texts.WriteLn(W);
		Texts.WriteString(W, "heap size: "); Texts.WriteInt(W, Kernel.heapEnd-Kernel.heapBeg, 0); Texts.WriteString(W, " bytes"); Texts.WriteLn(W);
		avail := Kernel.Available();
		Texts.WriteString(W, "allocated: "); Texts.WriteInt(W, Kernel.heapEnd - Kernel.heapBeg - avail, 0); Texts.WriteLn(W);
		Texts.WriteString(W, "available: "); Texts.WriteInt(W, avail, 0); Texts.WriteLn(W);
		Texts.WriteString(W, "largest free block: "); Texts.WriteInt(W, Kernel.LargestAvailable(), 0); Texts.WriteLn(W);
		Texts.Append(Oberon.Log, W.buf)
	END Watch;
	PROCEDURE Collect*;
	BEGIN Oberon.Collect(0)
	END Collect;
    PROCEDURE FreeMod (VAR S: Texts.Scanner);
    BEGIN
		Texts.WriteString(W, S.s); Texts.WriteString(W, " unloading");
		Texts.Append(Oberon.Log, W.buf);
		IF S.nextCh # "*" THEN Modules.Free(S.s, FALSE)
			ELSE Modules.Free(S.s, TRUE); Texts.Scan(S); Texts.WriteString(W, " all")
		END;
		IF Modules.res # 0 THEN Texts.WriteString(W, " failed") END;
		Texts.WriteLn(W);
		Texts.Append(Oberon.Log, W.buf)
    END FreeMod;
	PROCEDURE Free*;
		VAR par: Oberon.ParList;
			T: Texts.Text;
			S: Texts.Scanner;
            beg, end, time: LONGINT;
	BEGIN
		par := Oberon.Par;
        Texts.WriteString(W, "System.Free"); Texts.WriteLn(W);
        Texts.Append(Oberon.Log, W.buf);
		Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
		WHILE S.class = Texts.Name DO FreeMod(S); Texts.Scan(S) END;
        IF (S.class = Texts.Char) & (S.c = "^") THEN Oberon.GetSelection(T, beg, end, time);
          IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S);
            IF S.class = Texts.Name THEN FreeMod(S) END
          END
        END
	END Free;
	PROCEDURE ShowModules*;
		VAR T: Texts.Text;
			V: Viewers.Viewer;
			M: Modules.Module;
            X, Y, i: INTEGER;
	BEGIN
        T := TextFrames.Text("");
        Oberon.AllocateSystemViewer(Oberon.Par.vwr.X, X, Y);
        V := MenuViewers.New(
          TextFrames.NewMenu("System.ShowModules", "System.Close System.Copy System.Grow System.Free ^ Edit.Store "),
          TextFrames.NewText(T, 0),
          TextFrames.menuH,
          X, Y);
		M := Modules.modules;
		WHILE M # NIL DO
			Texts.WriteString(W, M.name);
			i := 0; WHILE M.name[i] # 0X DO INC(i) END ;
			i := 32-i; WHILE i > 0 DO Texts.Write(W, " "); DEC(i) END ;
			Texts.WriteString(W, "codesize = ");
			Texts.WriteInt(W, M.codesize, 5);
			Texts.WriteString(W, "  PC = "); Texts.WriteHex(W, M.PC);
			Texts.WriteString(W, "H  SB =  ");  Texts.WriteHex(W, M.SB);
			Texts.WriteString(W, "H  ");
			Texts.WriteString(W, "refcnt =  ");  Texts.WriteInt(W, M.refcnt, 0); Texts.WriteLn(W);
			M := M.link
		END;
		Texts.Append(T, W.buf)
	END ShowModules;
	PROCEDURE ShowCommands*;
		VAR
			M: Modules.Module; S: Texts.Scanner; beg, end, time, i, len: LONGINT;
			T: Texts.Text; V: Viewers.Viewer; X, Y: INTEGER; cmd: Modules.CommandPtr;
	BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
		IF (S.class = Texts.Char) & (S.c = "^") THEN Oberon.GetSelection(T, beg, end, time);
			IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END ;
		END ;
		IF S.class = Texts.Name THEN
			i := 0; WHILE S.s[i] >= "0" DO INC(i) END ;
			S.s[i] := 0X; M := Modules.ThisMod(S.s);
			IF M # NIL THEN i := 0; len := 0;
				IF M^.commands # 0 THEN len := M^.nofcmds END;
				Oberon.AllocateSystemViewer(Oberon.Par.vwr.X, X, Y);
				T := TextFrames.Text("");
				V := MenuViewers.New(
					TextFrames.NewMenu("System.Commands", "^System.Menu.Text"),
					TextFrames.NewText(T, 0),
					TextFrames.menuH,
					X, Y);
				cmd := SYSTEM.VAL (Modules.CommandPtr, M.commands);
				WHILE i < len DO
					Texts.WriteString(W, M.name); Texts.Write(W, ".");
					Texts.WriteString(W, cmd.name); Texts.WriteLn(W);
					cmd := SYSTEM.VAL (Modules.CommandPtr, SYSTEM.VAL (LONGINT, cmd)+26);
					INC(i)
				END ;
				Texts.Append(T, W.buf)
			END
		END
	END ShowCommands;
	PROCEDURE State*;
		VAR par: Oberon.ParList;
			t, T: Texts.Text;
			S: Texts.Scanner;
			V: Viewers.Viewer;
			mod: Modules.Module;
			X, Y: INTEGER;
			beg, end, time, ref, refend, p: LONGINT; 
			info: Sys.ExceptionInfoDesc;
			ch: CHAR;
	BEGIN par := Oberon.Par;
		Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
		IF (S.class = Texts.Char) & (S.c = "^") THEN Oberon.GetSelection(T, beg, end, time);
			IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END ;
		END ;
       Oberon.AllocateSystemViewer(par.vwr.X, X, Y);
        t := TextFrames.Text("");
        V := MenuViewers.New(
          TextFrames.NewMenu("System.State", "^System.Menu.Text"),
          TextFrames.NewText(t, 0),
          TextFrames.menuH,
          X, Y);
		WHILE S.class = Texts.Name DO
			p := 0; WHILE (p < LEN(S.s)) & (S.s[p] # 0X) & (S.s[p] # ".") DO INC(p) END;
			IF S.s[p] = "." THEN S.s[p] := 0X END;
			Texts.WriteString(W, S.s); mod := Modules.modules;
			WHILE (mod # NIL) & (mod.name # S.s) DO mod := mod.link END;
			IF mod # NIL THEN
				Texts.WriteString(W, " SB = "); Texts.WriteHex(W, mod.SB); Texts.Write(W, "H");
				ref := mod^.refs; refend := ref;
				IF mod^.refs # 0 THEN INC(refend, mod^.refsize) END;
				LOOP
					IF ref >= refend THEN EXIT END;
					SYSTEM.GET(ref, ch); INC(ref);
					IF ch = 0F8X THEN
						ReadInt(p, ref); ReadInt(p, ref); ReadInt(p, ref); ReadInt(p, ref); ReadInt(p, ref); ReadInt(p, ref);
						SYSTEM.GET(ref, ch); INC(ref);
						SYSTEM.GET(ref, ch); INC(ref);
						IF ch = "$" THEN EXIT END
					END
				END;
				IF (ref < refend) & (ch = "$") THEN
					INC(ref, 2); Locals(info, ref, refend, mod^.SB)
				END;
				Texts.WriteLn(W); Texts.Append(t, W.buf)
			ELSE
				Texts.WriteString(W, " not loaded"); Texts.WriteLn(W); Texts.Append(t, W.buf)
			END;
			Texts.Scan(S)
		END
	END State;
	PROCEDURE SetUser*;
		VAR i: INTEGER; ch: CHAR;
			user: ARRAY 8 OF CHAR;
			password: ARRAY 16 OF CHAR;
	BEGIN
		i := 0; Input.Read(ch);
		WHILE (ch # "/") & (i < 7) DO user[i] := ch; INC(i); Input.Read(ch) END;
		user[i] := 0X;
		i := 0; Input.Read(ch);
		WHILE (ch > " ") & (i < 15) DO password[i] := ch; INC(i); Input.Read(ch) END;
		password[i] := 0X;
		Oberon.SetUser(user, password)
	END SetUser;
	PROCEDURE CopyFile (name: ARRAY OF CHAR; VAR S: Texts.Scanner);
		VAR f, g: Files.File; Rf, Rg: Files.Rider; ch: CHAR;
	BEGIN Texts.Scan(S);
		IF (S.class = Texts.Char) & (S.c = "=") THEN Texts.Scan(S);
			IF (S.class = Texts.Char) & (S.c = ">") THEN Texts.Scan(S);
				IF (S.class = Texts.Name) OR (S.class = Texts.String) THEN
					Texts.WriteString(W, name); Texts.WriteString(W, " => "); Texts.WriteString(W, S.s);
					Texts.WriteString(W, " copying"); Texts.Append(Oberon.Log, W.buf);
					f := Files.Old(name);
					IF f # NIL THEN g := Files.New(S.s);
						Files.Set(Rf, f, 0); Files.Set(Rg, g, 0); Files.Read(Rf, ch);
						WHILE ~Rf.eof DO Files.Write(Rg, ch); Files.Read(Rf, ch) END;
						Files.Register(g)
					ELSE Texts.WriteString(W, " failed")
					END ;
					EndLine
				END
			END
		END
	END CopyFile;
	PROCEDURE CopyFiles*;
		VAR S: Texts.Scanner;
	BEGIN GetArg(S);
		Texts.WriteString(W, "System.CopyFiles"); EndLine;
		WHILE (S.class = Texts.Name) OR (S.class = Texts.String) DO CopyFile(S.s, S); Texts.Scan(S) END
	END CopyFiles;
	PROCEDURE RenameFile (name: ARRAY OF CHAR; VAR S: Texts.Scanner);
		VAR res: INTEGER;
	BEGIN Texts.Scan(S);
		IF (S.class = Texts.Char) & (S.c = "=") THEN Texts.Scan(S);
			IF (S.class = Texts.Char) & (S.c = ">") THEN Texts.Scan(S);
				IF (S.class = Texts.Name) OR (S.class = Texts.String) THEN
					Texts.WriteString(W, name); Texts.WriteString(W, " => "); Texts.WriteString(W, S.s);
					Texts.WriteString(W, " renaming"); Files.Rename(name, S.s, res);
					IF res > 1 THEN Texts.WriteString(W, " failed") END;
					EndLine
				END
			END
		END
	END RenameFile;
	PROCEDURE RenameFiles*;
		VAR S: Texts.Scanner;
	BEGIN GetArg(S);
		Texts.WriteString(W, "System.RenameFiles"); EndLine;
		WHILE (S.class = Texts.Name) OR (S.class = Texts.String) DO RenameFile(S.s, S); Texts.Scan(S) END
	END RenameFiles;
	PROCEDURE DeleteFile(VAR name: ARRAY OF CHAR);
		VAR res: INTEGER;
	BEGIN Texts.WriteString(W, name); Texts.WriteString(W, " deleting");
		Files.Delete(name, res);
		IF res # 0 THEN Texts.WriteString(W, " failed") END;
		EndLine
	END DeleteFile;
	PROCEDURE DeleteFiles*;
		VAR S: Texts.Scanner;
	BEGIN GetArg(S);
		Texts.WriteString(W, "System.DeleteFiles"); EndLine;
		WHILE (S.class = Texts.Name) OR (S.class = Texts.String) DO DeleteFile(S.s); Texts.Scan(S) END
	END DeleteFiles;
	PROCEDURE HasSpace (VAR str: ARRAY OF CHAR) : BOOLEAN;
	VAR i: INTEGER;
	BEGIN i := 0; WHILE (str[i] # 0X) & (str[i] # ' ') DO INC (i) END; RETURN str[i] = ' '
	END HasSpace;
	PROCEDURE ShowFile (d: Directories.Directory; name: ARRAY OF CHAR; isDir: BOOLEAN; VAR continue: BOOLEAN);
		VAR path: ARRAY 256 OF CHAR; time, date, size: LONGINT; f: Files.File;
	BEGIN
		IF Strings.Match(name, pattern) THEN
			COPY(d.path, path); Strings.Append(":", path); Strings.Append(name, path);
			IF allPaths IN options THEN 
				IF HasSpace (path) THEN Texts.Write (W, '"') END;
				Texts.WriteString(W, path);
				IF HasSpace (path) THEN Texts.Write (W, '"') END
			ELSIF fullPath THEN
				IF HasSpace (path) THEN Texts.Write (W, '"') END;
				Texts.WriteString(W, d.path);
				Texts.WriteString (W, name);
				IF isDir THEN Texts.Write (W, ':'); Texts.WriteString (W, pattern) END;
				IF HasSpace (path) THEN Texts.Write (W, '"') END
			ELSIF isDir THEN 
				IF HasSpace (name) THEN Texts.Write (W, '"') END;
				Texts.Write(W, ":"); Texts.WriteString(W, name);
				IF HasSpace (name) THEN Texts.Write (W, '"') END
			ELSE 
				IF HasSpace (name) THEN Texts.Write (W, '"') END;
				Texts.WriteString(W, name);
				IF HasSpace (name) THEN Texts.Write (W, '"') END
			END;
			IF ({dateOpt, sizeOpt} * options # {}) & ~isDir THEN
				f := Files.Old (path); ASSERT (f # NIL);
				Files.GetDate (f, time, date); size := Files.Length (f);
				Files.Close (f);
				IF dateOpt IN options THEN Texts.WriteString(W, "  "); Texts.WriteDate(W, time, date) END;
				IF sizeOpt IN options THEN Texts.WriteInt(W, size, 8) END
			END;
			Texts.WriteLn(W); Texts.Append(T, W.buf)
		END
	END ShowFile;
	PROCEDURE ScanDirectory (path: ARRAY OF CHAR; VAR continue: BOOLEAN);
		VAR d, cur, startup: Directories.Directory;
	BEGIN
		d := Directories.This(path); cur := Directories.Current(); startup := Directories.Startup();
		IF (d # NIL) & (d.path # cur.path) & (d.path # startup.path) THEN
			Directories.Enumerate(d, ShowFile);
			IF d.path = startup.path THEN startupDone := TRUE END
		END
	END ScanDirectory;
	PROCEDURE Directory*;
		VAR R: Texts.Reader; 
			t: Texts.Text; V: Viewers.Viewer; 
			beg, end, time: LONGINT;
			X, Y, i, len: INTEGER; c, ch: CHAR;
			dir, startup: Directories.Directory;
	BEGIN
		Texts.OpenReader(R, Oberon.Par.text, Oberon.Par.pos); Texts.Read(R, ch);
		WHILE ((ch = " ") OR (ch = 09X)) & ~R.eot DO Texts.Read(R, ch) END;
		IF ch = "^" THEN Oberon.GetSelection(t, beg, end, time);
			IF time >= 0 THEN Texts.OpenReader(R, t, beg); Texts.Read(R, ch);
				WHILE ((ch = " ") OR (ch = 09X)) & ~R.eot DO Texts.Read(R, ch) END
			END
		END;
		i := 0;
		IF (ch = "'") OR (ch = '"') THEN
			c := ch; Texts.Read(R, ch);
			WHILE (ch # c) & (ch >= " ") & ~R.eot DO pattern[i]:=ch; INC(i); Texts.Read(R, ch) END;
			Texts.Read(R, ch)
		ELSIF (ch > " ") & (ch # "/") & (ch # "^") THEN
			WHILE (ch > " ") & (ch # "/") DO pattern[i]:=ch; INC(i); Texts.Read(R, ch) END;
		END;
		pattern[i] := 0X;
		options := {};
		WHILE ((ch = " ") OR (ch = 09X)) & ~R.eot DO Texts.Read(R, ch) END;
		IF ch = "/" THEN
			LOOP Texts.Read(R, ch);
				IF ch = "d" THEN INCL(options, dateOpt) 
				ELSIF ch = "s" THEN INCL(options, sizeOpt) 
				ELSIF ch = "a" THEN INCL(options, allPaths)
				ELSE EXIT END
			END
		END;
		IF pattern = "" THEN RETURN END;
		T := TextFrames.Text(""); Oberon.AllocateSystemViewer(Oberon.Par.vwr.X, X, Y);
		V := MenuViewers.New(TextFrames.NewMenu("System.Directory", "^System.Menu.Text"), TextFrames.NewText(T, 0), 
			TextFrames.menuH, X, Y);
		startup := Directories.Startup ();
		len := Strings.Length (pattern);
		REPEAT DEC (len) UNTIL (len = -1) OR (pattern[len] = Directories.delimiter);
		fullPath := len # -1;
		IF len = -1 THEN
			dir := Directories.Current ()
		ELSE
			ch := pattern[len+1];
			pattern[len+1] := 0X; dir := Directories.This (pattern);
			pattern[len+1] := ch;
			i := 0;
			REPEAT
				INC (len);
				pattern[i] := pattern[len]; INC (i)
			UNTIL pattern[i] = 0X
		END;
		Directories.Enumerate(dir, ShowFile);
		startupDone := dir.path = startup.path;
		IF allPaths IN options THEN
			Directories.EnumeratePaths(ScanDirectory);
			IF ~startupDone THEN Directories.Enumerate(startup, ShowFile) END
		END
	END Directory;
	PROCEDURE ChangeDir*;
		VAR T: Texts.Text; S: Texts.Scanner; res: INTEGER; beg, end, time: LONGINT;
	BEGIN
		Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
		IF (S.class = Texts.Char) & (S.c = "^") OR (S.line # 0) THEN
			Oberon.GetSelection(T, beg, end, time);
			IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END
		END;
		IF ((S.class = Texts.Name) OR (S.class = Texts.String)) & (S.line = 0) THEN
			Texts.WriteString(W, S.s);
			Directories.Change(S.s);
			IF Directories.res # 0 THEN Texts.WriteString(W, "  -- failed") END;
			Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
		END
	END ChangeDir; 
	PROCEDURE CreateDir*;
		VAR T: Texts.Text; S: Texts.Scanner; res: INTEGER; beg, end, time: LONGINT; d: Directories.Directory;
	BEGIN
		Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
		IF (S.class = Texts.Char) & (S.c = "^") OR (S.line # 0) THEN
			Oberon.GetSelection(T, beg, end, time);
			IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END
		END;
		IF ((S.class = Texts.Name) OR (S.class = Texts.String)) & (S.line = 0) THEN
			Texts.WriteString(W, "System.CreateDir "); Texts.WriteString(W, S.s);
			Directories.Create(S.s);
			d := Directories.This(S.s);
			IF Directories.res # Directories.noErr THEN Texts.WriteString(W, " failed") END;
			Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
		END
	END CreateDir;
	PROCEDURE DeleteDir*;
		VAR T: Texts.Text; S: Texts.Scanner; res: INTEGER; beg, end, time: LONGINT; d: Directories.Directory;
	BEGIN
		Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
		IF (S.class = Texts.Char) & (S.c = "^") OR (S.line # 0) THEN
			Oberon.GetSelection(T, beg, end, time);
			IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END
		END;
		IF ((S.class = Texts.Name) OR (S.class = Texts.String)) & (S.line = 0) THEN
			Texts.WriteString(W, "System.DeleteDir "); Texts.WriteString(W, S.s);
			Directories.Delete(S.s);
			IF Directories.res # Directories.noErr THEN Texts.WriteString(W, " failed") END;
			Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
		END
	END DeleteDir;
	PROCEDURE HomeDir*;
		VAR d: Directories.Directory;
	BEGIN
		d := Directories.Startup();
		Directories.Change (d.path);
		Texts.WriteString(W, d.path); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
	END HomeDir;
	PROCEDURE ShowDir*;
		VAR d: Directories.Directory;
	BEGIN
		d := Directories.Current();
		Texts.WriteString(W, d.path); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
	END ShowDir;
	PROCEDURE ParentDir*;
		VAR d: Directories.Directory;
	BEGIN
		Directories.Change("::");
		IF Directories.res # 0 THEN 
			Texts.WriteString(W, "::  -- failed")
		ELSE
			d := Directories.Current();
			Texts.WriteString(W, d.path)
		END;
		Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
	END ParentDir;
	PROCEDURE Quit*;
	BEGIN
		Kernel.FinalizeAll;
		Kernel.quitQ.Handle;
		Sys.ExitToShell;
	END Quit;
	PROCEDURE Init;
	BEGIN
		trap := 0;
		OldTrap := Sys.InstallExceptionHandler (Trap);
	END Init;
	PROCEDURE OpenStandard;
		VAR X, Y: INTEGER; logV, toolV: Viewers.Viewer;
	BEGIN
		Oberon.AllocateSystemViewer(0, X, Y);
		logV := MenuViewers.New(
			TextFrames.NewMenu("System.Log", "^Log.Menu.Text"),
			TextFrames.NewText(Oberon.Log, 0),
			TextFrames.menuH,
			X, Y);
		Oberon.AllocateSystemViewer(0, X, Y);
		toolV := MenuViewers.New(
			TextFrames.NewMenu("System.Tool", "^System.Menu.Text"),
			TextFrames.NewText(TextFrames.Text("System.Tool"), 0),
			TextFrames.menuH,
			X, Y)
	END OpenStandard;
BEGIN
	Texts.OpenWriter(W);
	Init;
	Oberon.Log := TextFrames.Text("");
	Oberon.GetClock(t, d);
	Texts.WriteString(W, VersionString);
	Texts.WriteDate(W, t, d); Texts.WriteLn(W);
	Texts.Append(Oberon.Log, W.buf); 
	IF Modules.ThisMod("Configuration") = NIL THEN OpenStandard END
END System.